;; midi-receiver.scm - (c) rohan drape, 2002-2005

;; The list of registered midi-receivers.  Each element is a cons cell
;; of test procedure and receiver procedure.

(define-global midi-receiver-table (make-table))

;; Register a new midi-receiver.  Register the one argument procedure
;; `procedure' to receive incoming midi messages that match the
;; criteria mask `status-test'.  The criteria mask may be an integer
;; value for direct comparison, a proper list of integers for direct
;; membership test, a two-element vector of integers for a standard
;; range test (inclusive at left, exclusive at right), a one argument
;; predicate procedure, or the boolean value '#t' to match all
;; incoming messages.  The registered procedure must accept as
;; arguments the status-byte, and any data bytes associated with the
;; message types the receiver requests.

(define (midi-receiver-register status-test procedure)
  
  ;; Make a one-argument procedure to run `status-test'. 

  (define (make-canonical-test status-test)
    (cond ((and (boolean? status-test) 
		status-test)
	   (lambda (value) #t))
	  ((integer? status-test)
	   (lambda (value) (= status-test value)))
	  ((and (list? status-test)
		(uniform? integer? status-test))
	   (lambda (value) (member* value status-test =)))
	  ((and (vector? status-test) 
		(= (vector-length status-test) 2)
		(integer? (vector-ref status-test 0)) 
		(integer? (vector-ref status-test 0)))
	   (lambda (value) (and (>= value (vector-ref status-test 0))
				(< value (vector-ref status-test 1)))))
	  ((procedure? status-test)
	   status-test)
	  (else
	   (error "make-canonical-test: Bad status-test value" status-test))))

  (table-put! (midi-receiver-table)
	      procedure
	      (make-canonical-test status-test)))

;; Unregister a midi-receiver procedure.

(define (midi-receiver-unregister procedure)
  (table-remove! (midi-receiver-table) procedure))

;; Unregister all registered midi-receivers.

(define (midi-receiver-clear)
  (table-clear! (midi-receiver-table)))

;; Match each registered midi-receiver against the incoming midi data,
;; and apply the registered procedure if appropriate.  The midi-event
;; should be an <integer-list>.

(define (midi-receiver-dispatch midi-event)
  (table-for-each 
   (lambda (handler predicate)
     (if (predicate (car midi-event))
	 (apply handler midi-event)))
   (midi-receiver-table)))
